home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SORTING.SWG / 0050_Alphabetical Order.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  2KB  |  78 lines
  1.  
  2. { This unit will sort ANY type of data into ANY type of order. As an added
  3. bonus, there are a routine to search through a sorted list of ANY type...
  4. Credits go to Björn Felten for his QSort unit, which inspired me to write this
  5. routine }
  6.  
  7. Unit SortSrch;
  8.  
  9. interface
  10.  
  11. Type
  12.     CompFunc = Function(Item1, Item2: Integer): Integer;
  13.     SwapProc = Procedure(Item1, Item2: Integer);
  14.     CompOneFunc = Function(Item: Integer): Integer;
  15.  
  16. Procedure QuickSort(First, Last: Integer; Comp: CompFunc; Swap: SwapProc);
  17. Function BinarySearch(First, Last: Integer; CompOne: CompOneFunc): Integer;
  18.  
  19. implementation
  20.  
  21. Procedure Partition(First, Last: Integer; Var SplitIndex: Integer;
  22.           Comp: CompFunc; Swap: SwapProc);
  23.  
  24.   Var
  25.     Up, Down, Middle: Integer;
  26.  
  27.   Begin
  28.     Middle := ((Last - First) DIV 2 ) + First;
  29.     Up := First;
  30.     Down := Last;
  31.     Repeat
  32.       While (Comp(Up, Middle) <= 0) And (Up < Last) Do Inc(Up);
  33.       While (Comp(Down, Middle) > 0) And (Down > First) Do Dec(Down);
  34.       If Up < Down Then
  35.          Swap(Up, Down);
  36.     Until Up >= Down;
  37.     SplitIndex := Down;
  38.     Swap(Middle, SplitIndex);
  39.   End;
  40.  
  41. Procedure QuickSort(First, Last: Integer; Comp: CompFunc; Swap: SwapProc);
  42.  
  43.   Var
  44.     SplitIndex: Integer;
  45.  
  46.   Begin
  47.     If First < Last Then
  48.       Begin
  49.         Partition(First, Last, SplitIndex, Comp, Swap);
  50.         QuickSort(First, SplitIndex - 1, Comp, Swap);
  51.         QuickSort(SplitIndex + 1, Last, Comp, Swap);
  52.       End;
  53.   End;
  54.  
  55. Function BinarySearch(First, Last: Integer; CompOne: CompOneFunc): Integer;
  56.  
  57.   Var
  58.     Middle, Jfr: Integer;
  59.  
  60.   Begin
  61.     Repeat
  62.       Middle := ((Last - First) DIV 2 ) + First;
  63.       Jfr := CompOne(Middle);
  64.       If Jfr = 0 Then
  65.         Begin
  66.           BinarySearch := Middle;
  67.           Exit;
  68.         End
  69.       Else If Jfr > 0 Then
  70.         First := Middle
  71.       Else
  72.         Last := Middle;
  73.     Until First = Last;
  74.     BinarySearch := -1;
  75.   End;
  76.  
  77. end.
  78.